Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue45/Alfresco/AALZHash.pas

Pascal/Delphi Source File | 2000-11-02 | 8.5 KB | 291 lines

{*********************************************************}
{* AALZHash                                              *}
{* Copyright (c) Julian M Bucknall 1998-1999             *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Algorithms Alfresco LZ77 unit - Hash Table            *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AALZHash;

interface

uses
  SysUtils,
  Classes,
  AALZBase;

{Notes: Although a pretty standard hash table with chaining this
        particular version has several changes to make it more
        applicable to LZ compression.
        Firstly all key strings are 3 characters long. The hash
        function is the three characters of the key as the three
        lowest bytes of a longint, with the upper byte set to zero.
        Secondly the items in the hash table comprise the 3 character
        key string, together with the input stream offset where the
        string appears.
        Thirdly the offset is used as a least recently used indicator:
        when a key is searched for, older nodes in the chains are
        freed automatically. Older nodes equate to lower offsets.

        Although a delete method could be written, because of the way
        this hash table is designed to be used, there is none.

        All nodes in the hash table are 12 bytes long (next pointer,
        key string and offset) and so a node manager is used for
        space and speed efficiency reasons.
        }

type
  ThtLZKeyEnumProc = procedure (aExtraData : pointer;
                          const aKey       : TaaLZKey;
                                aOffset    : longint);

  PaaLZHashNode = ^TaaLZHashNode;
  TaaLZHashNode = packed record
    hnNext   : PaaLZHashNode;
    hnKey    : TaaLZKey;
    hnOffset : longint;
  end;

  TaaLZHashTable = class
    {-a hash table for LZ77 compression}
    private
      htlArray     : TList;
    protected
      procedure htlFreeChain(aFromNode : PaaLZHashNode; aIsParent : boolean);
    public
      constructor Create;
        {-constructor to create a hash table for LZ data compression}
      destructor Destroy; override;
        {-destructor to destroy the hash table}

      procedure Empty;
        {-delete all elements in the hash table and reset it to empty}
      function FindAll(const aKey       : TaaLZKey;
                             aCutOffset : longint;
                             aAction    : ThtLZKeyEnumProc;
                             aExtraData : pointer) : boolean;
        {-find all the elements defined by aKey; Call aAction for each
          one found. All nodes encountered less than aCutOffset are
          automatically removed. Returns true if there was at least
          one element found with key aKey.}
      procedure Insert(const aKey    : TaaLZKey;
                             aOffset : longint);
        {-insert a new element defined by aKey with its associated
          offset aOffset. It is assumed that Insert is called with
          strictly increasing values of aOffset.}
  end;

implementation

{$DEFINE UseNodeManager}

const
  HashTableSize = 521; {a prime}

{===SingleNodeManager================================================}
const
  PageNodeCount = 100;
type
  PsnmPage = ^TsnmPage;
  TsnmPage = packed record
    snmpNext  : PsnmPage;
    snmpNodes : array [0..pred(PageNodeCount)] of TaaLZHashNode;
  end;
{--------}
var
  snmFreeList : PaaLZHashNode;
  snmPageList : PsnmPage;
{--------}
procedure snmFreeNode(aNode : PaaLZHashNode);
begin
  {$IFDEF UseNodeManager}
  {add the node to the top of the free list}
  aNode^.hnNext := snmFreeList;
  snmFreeList := aNode;
  {$ELSE}
  Dispose(aNode);
  {$ENDIF}
end;
{--------}
procedure snmAllocPage;
var
  NewPage : PsnmPage;
  i       : integer;
begin
  {get a new page}
  New(NewPage);
  {add it to the current list of pages}
  NewPage^.snmpNext := snmPageList;
  snmPageList := NewPage;
  {add all the nodes on the page to the free list}
  for i := 0 to pred(PageNodeCount) do
    snmFreeNode(@NewPage^.snmpNodes[i]);
end;
{--------}
function snmAllocNode : PaaLZHashNode;
begin
  {$IFDEF UseNodeManager}
  {if the free list is empty, allocate a new page of nodes}
  if (snmFreeList = nil) then
    snmAllocPage;
  {return the first node on the free list}
  Result := snmFreeList;
  snmFreeList := Result^.hnNext;
  {$ELSE}
  New(Result);
  {$ENDIF}
  {$IFDEF InDebugMode}
  FillChar(Result^, sizeof(Result^), $CC);
  {$ENDIF}
end;
{====================================================================}


{===Helper routines==================================================}
procedure RaiseException(const S : string);
begin
  raise Exception.Create(S);
end;
{====================================================================}


{===TaaLZHashTable===============================================}
constructor TaaLZHashTable.Create;
begin
  inherited Create;
  htlArray := TList.Create;
  htlArray.Count := HashTableSize;
end;
{--------}
destructor TaaLZHashTable.Destroy;
begin
  if (htlArray <> nil) then begin
    Empty;
    htlArray.Free;
  end;
  inherited Destroy;
end;
{--------}
procedure TaaLZHashTable.Empty;
var
  Inx : integer;
  ChainHead : PaaLZHashNode;
begin
  for Inx := 0 to pred(HashTableSize) do begin
    ChainHead := PaaLZHashNode(htlArray[Inx]);
    if (ChainHead <> nil) then begin
      htlFreeChain(ChainHead, false);
      htlArray[Inx] := nil;
    end;
  end;
end;
{--------}
function TaaLZHashTable.FindAll(const aKey       : TaaLZKey;
                                      aCutOffset : longint;
                                      aAction    : ThtLZKeyEnumProc;
                                      aExtraData : pointer) : boolean;
var
  Inx : integer;
  Temp : PaaLZHashNode;
  Dad  : PaaLZHashNode;
begin
  {assume we don't find any}
  Result := false;
  {calculate the hash table index for this key}
  Inx := (aKey.AsLong shr 8) mod HashTableSize;
  {wander along the chain at this index}
  Dad := nil;
  Temp := PaaLZHashNode(htlArray[Inx]);
  while (Temp <> nil) do begin
    {if this node has an offset that is less than the cutoff offset,
     then remove the rest of this chain and exit}
    if (Temp^.hnOffset < aCutOffset) then begin
      if (Dad = nil) then begin
        htlFreeChain(Temp, false);
        htlArray[Inx] := nil;
      end
      else
        htlFreeChain(Dad, true);
      Exit;
    end;
    {if the node's key matches our key, call the action routine}
    if (Temp^.hnKey.AsLong = aKey.AsLong) then begin
      Result := true;
      aAction(aExtraData, aKey, Temp^.hnOffset);
    end;
    {advance to the next node}
    Dad := Temp;
    Temp := Dad^.hnNext;
  end;
end;
{--------}
procedure TaaLZHashTable.htlFreeChain(aFromNode : PaaLZHashNode;
                                      aIsParent : boolean);
var
  Temp : PaaLZHashNode;
begin
  if aIsParent then begin
    Temp := aFromNode^.hnNext;
    aFromNode^.hnNext := nil;
  end
  else
    Temp := aFromNode;
  while (Temp <> nil) do begin
    aFromNode := Temp^.hnNext;
    snmFreeNode(Temp);
    Temp := aFromNode;
  end;
end;
{--------}
procedure TaaLZHashTable.Insert(const aKey : TaaLZKey;
                                      aOffset : longint);
var
  Inx     : integer;
  NewNode : PaaLZHashNode;
begin
  {calculate the hash table index for this key}
  Inx := (aKey.AsLong shr 8) mod HashTableSize;
  {allocate a new node and insert at the head of the chain at this
   index in the hash table; this ensures that the nodes in the chain
   are in reverse order of offset value}
  NewNode := snmAllocNode;
  NewNode^.hnKey := aKey;
  NewNode^.hnOffset := aOffset;
  NewNode^.hnNext := htlArray[Inx];
  htlArray[Inx] := NewNode;
end;
{====================================================================}

procedure FinalizeUnit; far;
var
  STemp : PsnmPage;
begin
  {destroy all the single node pages}
  STemp := snmPageList;
  while (STemp <> nil) do begin
    snmPageList := STemp^.snmpNext;
    Dispose(STemp);
    STemp := snmPageList;
  end;
end;

initialization
  snmFreeList := nil;
  snmPageList := nil;
  {$IFDEF Windows}
  AddExitProc(FinalizeUnit);
  {$ENDIF}

{$IFDEF WIN32}
finalization
  FinalizeUnit;
{$ENDIF}

end.